perm filename SINE.PAS[S1,ALS] blob
sn#394410 filedate 1979-07-23 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (*$A+,D+*)
C00004 ENDMK
Cā;
(*$A+,D+*)
program CHIOSINE(OUTPUT);
const NROW = 51;
NCOL = 51;
NCYCLES = 2;
PI = 3.141593;
TWOPI = 6.283185;
PIOVER2 = 1.570796;
IFACT3 = 0.1666667;
IFACT5 = 0.008333333;
IFACT7 = 0.0001984127;
var R, C : integer;
X, XARG, SIGNREV, XSQ, SINX : real;
PAGE : array [1..NROW,1..NCOL] of char;
begin
for R := 1 to NROW do
for C := 1 to NCOL do
PAGE[R,C] := '.';
for C := 1 to NCOL do
begin
XARG := TWOPI * NCYCLES * (C-1) / (NCOL-1);
X := XARG;
SIGNREV := 1.0;
if X < 0.0 then
begin
X := -X;
SIGNREV := -SIGNREV
end;
X := X - TWOPI*trunc(X/TWOPI);
case trunc(X/PIOVER2) of
0: ;
1: X := PI - X;
2: begin X := X - PI; SIGNREV := -SIGNREV end;
3: begin X := TWOPI - X; SIGNREV := -SIGNREV end;
4: X := X - TWOPI
end (*case*);
XSQ := X*X;
(* SINX := SIGNREV*X*(1-XSQ*(1/6-XSQ*(1/120-XSQ*(1/5040)))); *)
SINX := SIGNREV*X*(1-XSQ*(IFACT3-XSQ*(IFACT5-XSQ*(IFACT7))));
R := (NROW+1) div 2 + trunc(((NROW-1) div 2) * SINX);
PAGE[R,C] := '6'
end;
for R := 1 to NROW do
begin
WRITE('.');
for C := 1 to NCOL do
WRITE(PAGE[R,C]);
WRITELN();
end
end.